{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit ImageProcessing;

interface

uses GDIPOBJ;

type
  TAHMImageProcessor = class
  private
  protected
    class function Sharpen(Bmp: TGPBitmap; Factor: Single): Boolean;
    class function GaussianBlur(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
    class function FastGaussianBlur(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
    class function FastGaussianGlow(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
    class function RandomNoise(Bmp: TGPBitmap; Intensity: Integer): Boolean;
    class function Saturate(Bmp: TGPBitmap; Zone: Integer = 1): Boolean;
  public
    class function GaussianGlow(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
  end;

implementation

uses
  Math, Colour, GDIPAPI;

class function TAHMImageProcessor.Sharpen(Bmp: TGPBitmap; Factor: single): Boolean;
var
  tmp: TGPBItmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, ix, iy, xx, yy: integer;
  sr, sg, sb, sa, weight:integer;
begin
  Result := False;

  if (factor < 0) or (factor > 1) then Exit;

  w := bmp.GetWidth;
  h := bmp.GetHeight;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite,
                            PixelFormat32bppARGB, dbd) <> Ok then Exit;

  tmp := bmp.Clone(MakeRect(0, 0, w, h), PixelFormat32bppARGB);

  if tmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then
  begin
    tmp.Free;
    Exit;
  end;

  ps := sbd.Scan0;
  sstride := sbd.Stride;

  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sr := 0; sg := 0; sb := 0; sa := 0;
      for iy := y-1 to y+1 do
        for ix := x-1 to x+1 do
        begin
          if (iy = y) and (ix = x) then weight := 8 else weight := -1;
          xx := ix; yy := iy;
          if (iy < 0) or (iy > h-1) then yy := y;
          if (ix < 0) or (ix > w-1) then xx := x;

          pp := ps;
          inc(pp, (xx shl 2) + sstride * yy);
          sr := sr + PColourPixel(pp)^[ctRed] * weight;
          sg := sg + PColourPixel(pp)^[ctGreen] * weight;
          sb := sb + PColourPixel(pp)^[ctBlue] * weight;
          sa := sa + PColourPixel(pp)^[ctAlpha] * weight;
        end;

      pp := ps;
      inc(pp, (x shl 2) + sstride * y);
      sb := PColourPixel(pp)^[ctBlue] + Round(sb*factor);
      sg := PColourPixel(pp)^[ctGreen] + Round(sg*factor);
      sr := PColourPixel(pp)^[ctRed] + Round(sr*factor);
      sa := PColourPixel(pp)^[ctAlpha] + Round(sa*factor);

      if sb > 255 then dpx^[ctBlue] := 255
      else if sb < 0 then dpx^[ctBlue] := 0
      else dpx^[ctBlue] := sb;

      if sg > 255 then dpx^[ctGreen] := 255
      else if sg < 0 then dpx^[ctGreen] := 0
      else dpx^[ctGreen] := sg;

      if sr > 255 then dpx^[ctRed] := 255
      else if sr < 0 then dpx^[ctRed] := 0
      else dpx^[ctRed] := sr;

      if sa > 255 then dpx^[ctAlpha] := 255
      else if sa < 0 then dpx^[ctAlpha] := 0
      else dpx^[ctAlpha] := sa;

      inc(dpx);
    end;

    inc(dpscanline,dstride);
  end;

  tmp.UnlockBits(sbd);
  bmp.UnlockBits(dbd);
  tmp.Free;

  Result := True;
end;

class function TAHMImageProcessor.GaussianBlur(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
const
  gf:array[1..7,-7..7] of integer =
     ((0, 0,  0,  0,   0,  0,    1,   2,   1,   0,   0,  0,  0, 0,0),
      (0, 0,  0,  0,   0,  1,    4,   6,   4,   1,   0,  0,  0, 0,0),
      (0, 0,  0,  0,   1,  6,   15,  20,  15,   6,   1,  0,  0, 0,0),
      (0, 0,  0,  1,   8,  28,  56,  70,  56,  28,   8,  1,  0, 0,0),
      (0, 0,  1, 10,  45, 120, 210, 252, 210, 120,  45, 10,  1, 0,0),
      (0, 1, 13, 78, 286, 715,1287,1584,1287, 715, 286, 78, 13, 1,0),
      (1,15,105,455,1365,3003,4873,5742,4873,3003,1365,455,105,15,1));
var
  tmp: TGPBItmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, ix, iy: integer;
  count, sr, sg, sb, sa:integer;
begin
  Result := false;
  if (zone < 1) or (zone > 7) then exit;

  w := bmp.GetWidth;
  h := bmp.GetHeight;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, dbd) <> Ok then exit;

  tmp := bmp.Clone(MakeRect(0, 0, w, h), PixelFormat32bppARGB);

  if tmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then
  begin
    tmp.Free;
    exit;
  end;

  // Sum kernel count for selected blur distance
  count := 0;
  for ix := -zone to zone do
    count := count + gf[zone, ix];

  // First pass, copy bmp to tmp for x blur
  ps := dbd.Scan0;
  sstride := dbd.Stride;
  dpscanline := sbd.Scan0;
  dstride := sbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sr := 0; sg := 0; sb := 0; sa := 0;
      for ix := Max(x-zone, 0) to Min(x+zone, w-1) do
      begin
        pp := ps;
        inc(pp, (ix shl 2) + sstride*y);
        sr := sr + PColourPixel(pp)^[ctRed] * gf[zone, ix-x];
        sg := sg + PColourPixel(pp)^[ctGreen] * gf[zone, ix-x];
        sb := sb + PColourPixel(pp)^[ctBlue] * gf[zone, ix-x];
        sa := sa + PColourPixel(pp)^[ctAlpha] * gf[zone, ix-x];
      end;
      dpx^[ctBlue] := sb div count;
      dpx^[ctGreen] := sg div count;
      dpx^[ctRed] := sr div count;
      dpx^[ctAlpha] := sa div count;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  // Second pass, copy tmp to bmp for y blur
  ps := sbd.Scan0;
  sstride := sbd.Stride;
  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sr := 0; sg := 0; sb := 0; sa := 0;
      for iy := Max(y-zone, 0) to Min(y+zone, h-1) do
      begin
        pp := ps;
        inc(pp, (x shl 2) + sstride*iy);
        sr := sr + PColourPixel(pp)^[ctRed] * gf[zone, iy-y];
        sg := sg + PColourPixel(pp)^[ctGreen] * gf[zone, iy-y];
        sb := sb + PColourPixel(pp)^[ctBlue] * gf[zone, iy-y];
        sa := sa + PColourPixel(pp)^[ctAlpha] * gf[zone, iy-y];
      end;
      dpx^[ctBlue] := sb div count;
      dpx^[ctGreen] := sg div count;
      dpx^[ctRed] := sr div count;
      dpx^[ctAlpha] := sa div count;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  tmp.UnlockBits(sbd);
  bmp.UnlockBits(dbd);
  tmp.Free;

  Result := true;
end;

// Optimised version of above method using approximated bitwise weightings
class function TAHMImageProcessor.FastGaussianBlur(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
const
  gf:array[1..7,-7..7] of integer =
     ((0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 0, 0, 2, 3, 2, 0, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 0, 3, 4, 5, 4, 3, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 3, 5, 6, 7, 6, 5, 3, 0, 0, 0, 0),
      (0, 0, 0, 4, 6, 7, 8, 9, 8, 7, 6, 4, 0, 0, 0),
      (0, 0, 4, 6, 8, 9,10,11,10, 9, 8, 6, 4, 0, 0),
      (0, 4, 7, 9,10,11,12,13,12,11,10, 9, 7, 4, 0));
var
  tmp: TGPBItmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  c: TColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, ix, iy: integer;
  count, sr, sg, sb, sa:integer;
begin
  Result := False;
  if (zone < 1) or (zone > 7) then Exit;

  w := bmp.GetWidth;
  h := bmp.GetHeight;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, dbd) <> Ok then exit;

  tmp := bmp.Clone(MakeRect(0, 0, w, h), PixelFormat32bppARGB);

  if tmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then
  begin
    tmp.Free;
    Exit;
  end;

  // Sum kernel count for selected blur distance
  count := 0;
  for ix := -zone to zone do
    count := count + (1 shl gf[zone, ix]);

  // First pass, copy bmp to tmp for x blur
  ps := dbd.Scan0;
  sstride := dbd.Stride;
  dpscanline := sbd.Scan0;
  dstride := sbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sr := 0; sg := 0; sb := 0; sa := 0;
      for ix := Max(x-zone, 0) to Min(x+zone, w-1) do
      begin
        pp := ps;
        inc(pp, (ix shl 2) + sstride*y);
        sr := sr + (PColourPixel(pp)^[ctRed] shl gf[zone, ix-x]);
        sg := sg + (PColourPixel(pp)^[ctGreen] shl gf[zone, ix-x]);
        sb := sb + (PColourPixel(pp)^[ctBlue] shl gf[zone, ix-x]);
        sa := sa + (PColourPixel(pp)^[ctAlpha] shl gf[zone, ix-x]);
      end;
      dpx^[ctRed] := sr div count;
      dpx^[ctBlue] := sb div count;
      dpx^[ctGreen] := sg div count;
      dpx^[ctAlpha] := sa div count;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  // Second pass, copy tmp to bmp for y blur
  ps := sbd.Scan0;
  sstride := sbd.Stride;
  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sr := 0; sg := 0; sb := 0; sa := 0;
      for iy := Max(y-zone, 0) to Min(y+zone, h-1) do
      begin
        pp := ps;
        inc(pp, (x shl 2) + sstride*iy);
        sr := sr + (PColourPixel(pp)^[ctRed] shl gf[zone, iy-y]);
        sg := sg + (PColourPixel(pp)^[ctGreen] shl gf[zone, iy-y]);
        sb := sb + (PColourPixel(pp)^[ctBlue] shl gf[zone, iy-y]);
        sa := sa + (PColourPixel(pp)^[ctAlpha] shl gf[zone, iy-y]);
      end;
      dpx^[ctRed] := sr div count;
      dpx^[ctBlue] := sb div count;
      dpx^[ctGreen] := sg div count;
      dpx^[ctAlpha] := sa div count;
    end;
    inc(dpscanline,dstride);
  end;

  tmp.UnlockBits(sbd);
  bmp.UnlockBits(dbd);
  tmp.Free;

  Result := true;
end;

class function TAHMImageProcessor.FastGaussianGlow(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
const
  gf:array[1..7,-7..7] of integer =
     ((0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 0, 0, 2, 3, 2, 0, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 0, 3, 4, 5, 4, 3, 0, 0, 0, 0, 0),
      (0, 0, 0, 0, 3, 5, 6, 7, 6, 5, 3, 0, 0, 0, 0),
      (0, 0, 0, 4, 6, 7, 8, 9, 8, 7, 6, 4, 0, 0, 0),
      (0, 0, 4, 6, 8, 9,10,11,10, 9, 8, 6, 4, 0, 0),
      (0, 4, 7, 9,10,11,12,13,12,11,10, 9, 7, 4, 0));
var
  tmp: TGPBItmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  c: TColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, ix, iy: integer;
  count, sa:integer;
begin
  Result := False;
  if (zone < 1) or (zone > 7) then Exit;

  w := bmp.GetWidth;
  h := bmp.GetHeight;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, dbd) <> Ok then exit;

  tmp := bmp.Clone(MakeRect(0, 0, w, h), PixelFormat32bppARGB);

  if tmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite or ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then
  begin
    tmp.Free;
    Exit;
  end;

  // Sum kernel count for selected blur distance
  count := 0;
  for ix := -zone to zone do
    count := count + (1 shl gf[zone, ix]);

  // First pass, copy bmp to tmp for x blur
  ps := dbd.Scan0;
  sstride := dbd.Stride;
  dpscanline := sbd.Scan0;
  dstride := sbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sa := 0;
      for ix := Max(x-zone, 0) to Min(x+zone, w-1) do
      begin
        pp := ps;
        inc(pp, (ix shl 2) + sstride*y);
        sa := sa + (PColourPixel(pp)^[ctAlpha] shl gf[zone, ix-x]);
      end;
      dpx^[ctRed] := 255;
      dpx^[ctBlue] := 255;
      dpx^[ctGreen] := 255;
      dpx^[ctAlpha] := sa div count;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  // Second pass, copy tmp to bmp for y blur
  ps := sbd.Scan0;
  sstride := sbd.Stride;
  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);
    for x := 0 to w-1 do
    begin
      sa := 0;
      for iy := Max(y-zone, 0) to Min(y+zone, h-1) do
      begin
        pp := ps;
        inc(pp, (x shl 2) + sstride*iy);
        sa := sa + (PColourPixel(pp)^[ctAlpha] shl gf[zone, iy-y]);
      end;
      dpx^[ctRed] := 255;
      dpx^[ctBlue] := 255;
      dpx^[ctGreen] := 255;
      dpx^[ctAlpha] := sa div count;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  tmp.UnlockBits(sbd);
  bmp.UnlockBits(dbd);
  tmp.Free;

  Result := true;
end;


class function TAHMImageProcessor.RandomNoise(Bmp: TGPBitmap; Intensity: integer): Boolean;
var
  src: TGPBitmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, xs, ys: integer;
begin
  Result := False;

  if (intensity > 10) or (intensity < 1) then Exit;
  w := bmp.GetWidth;
  h := bmp.GetHeight;

  Randomize;

  src := bmp.Clone(0, 0, w, h, bmp.GetPixelFormat);

  if src.LockBits(MakeRect(0, 0, w, h), ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then exit;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite,
                            PixelFormat32bppARGB, dbd) <> Ok then exit;

  ps := sbd.Scan0;
  sstride := sbd.Stride;
  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);

    for x := 0 to w-1 do
    begin
      repeat
        case Random(20 - intensity*2 + 9) of
          0: begin xs := x-1; ys := y-1; end;
          1: begin xs := x;   ys := y-1; end;
          2: begin xs := x+1; ys := y-1; end;
          3: begin xs := x-1; ys := y;   end;
          4: begin xs := x+1; ys := y;   end;
          5: begin xs := x-1; ys := y+1; end;
          6: begin xs := x;   ys := y+1; end;
          7: begin xs := x+1; ys := y+1; end;
        else
          begin xs := x; ys := y; end;
        end;
      until (xs >= 0) and (xs <= w-1) and (ys >= 0) and (ys <= h - 1);

      pp := ps;
      inc(pp,(xs shl 2) + sstride*ys);
      dpx^ := PColourPixel(pp)^;
      inc(dpx);
    end;

    inc(dpscanline,dstride);
  end;

  src.UnlockBits(sbd);
  bmp.UnlockBits(dbd);

  Result := True;
end;

class function TAHMImageProcessor.Saturate(Bmp: TGPBitmap; Zone: Integer = 1): Boolean;
var
  tmp: TGPBitmap;
  sbd, dbd: TBitmapData;
  dpscanline: PByte;
  dpx: PColourPixel;
  ps, pp: PByte;
  w, h, sstride, dstride, x, y, ix, iy: integer;
  rmax, gmax, bmax, amax: byte;
begin
  Result := False;

  if (zone < 1) or (zone > 5) then Exit;

  w := bmp.GetWidth;
  h := bmp.GetHeight;

  if bmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeWrite,
                            PixelFormat32bppARGB, dbd) <> Ok then Exit;

  tmp := bmp.Clone(MakeRect(0, 0, w, h), PixelFormat32bppARGB);

  if tmp.LockBits(MakeRect(0, 0, w, h), ImageLockModeRead,
                            PixelFormat32bppARGB, sbd) <> Ok then
  begin
    tmp.Free;
    Exit;
  end;

  ps := sbd.Scan0;
  sstride := sbd.Stride;

  dpscanline := dbd.Scan0;
  dstride := dbd.Stride;

  for y := 0 to h-1 do
  begin
    dpx := PColourPixel(dpscanline);

    for x := 0 to w-1 do
    begin
      rmax := 0; gmax := 0; bmax := 0; amax := 0;

      for iy := Max(y-zone, 0) to Min(y+zone, h-1) do
        for ix := Max(x-zone, 0) to Min(x+zone, w-1) do
        begin
          pp := ps;
          inc(pp, (ix shl 2) + sstride*iy);
          if PColourPixel(pp)^[ctRed] > rmax then rmax := PColourPixel(pp)^[ctRed];
          if PColourPixel(pp)^[ctGreen] > gmax then gmax := PColourPixel(pp)^[ctGreen];
          if PColourPixel(pp)^[ctBlue] > bmax then bmax := PColourPixel(pp)^[ctBlue];
          if PColourPixel(pp)^[ctAlpha] > amax then amax := PColourPixel(pp)^[ctAlpha];
        end;
      dpx^[ctRed] := rmax;
      dpx^[ctBlue] := gmax;
      dpx^[ctGreen] := bmax;
      dpx^[ctAlpha] := amax;
      inc(dpx);
    end;
    inc(dpscanline,dstride);
  end;

  tmp.UnlockBits(sbd);
  bmp.UnlockBits(dbd);
  tmp.Free;

  Result := True;
end;

class function TAHMImageProcessor.GaussianGlow(Bmp: TGPBitmap; Zone: Integer = 2): Boolean;
var
  Backup: TGPBitmap;
  Renderer: TGPGraphics;
begin
  // First take a copy of original bitmap
  with Bmp do
    Backup := Clone(MakeRect(0, 0, GetWidth, GetHeight), GetPixelFormat);

  // Apply blur to alpha channel to create halo
  Result := FastGaussianGlow(Bmp, Zone);

  // Now overlay original image to give background glow effect
  Renderer := TGPGraphics.Create(Bmp);
  Renderer.DrawImage(Backup, 0, 0);
  Renderer.Free;
  Backup.Free;
end;


end.
